(FILECREATED " 6-APR-74 07:17:52" DRAW)


  (LISPXPRINT (QUOTE DRAWVARS)
              T)
  [RPAQQ DRAWVARS ((FNS DRAW PRINN DRAWS GENLET PRINRAD NUMNODES PRINRAD1 
                        PRINCTAB PRINENTRY PRINRADOFF)
          (VARS (DRAWFORK))
          (USERMACROS DRAWS DRAW)
          (ADVICE (SUBSYS IN DRAW]
(DEFINEQ

(DRAW
  [LAMBDA (STRUC)
    (PROG (O)
          [SETQ O (OUTPUT (OUTFILE (QUOTE FOR01.DAT;T]
                                                (* Now, "BIND" the output to O 
                                                while executing the printing)
          [RESETFORM (OUTPUT O)
                     (PROG NIL
                       LP  (COND
                             ((NULL STRUC)
                               (RETURN))
                             ((STRUCLIST? STRUC)
                               (SETQ STRUC (CDDR STRUC))
                               (GO LP))
                             ((type? STRUCTURE STRUC)
                               (DRAWS STRUC))
                             ((RADICAL? STRUC)
                               (PRINRAD STRUC))
                             ((type? STRUCTURE (CAR STRUC))
                               (DRAWS (CAR STRUC)
                                      NIL)
                               (SETQ STRUC (CDR STRUC))
                               (GO LP))
                             ((RADICAL? (CAR STRUC))
                               (PRINRAD (CAR STRUC))
                               (SETQ STRUC (CDR STRUC))
                               (GO LP))
                             (T (CLOSEF O)
                                (ERROR!]
          (CLOSEF O)
          (COND
            ([NOT (CAR (NLSETQ (AND DRAWFORK (SUBSYS DRAWFORK NIL NIL
                                                     (QUOTE START]
              (SETQ DRAWFORK (SUBSYS (QUOTE DRAW])

(PRINN
  [LAMBDA (N L)
    (SPACES (IDIFFERENCE L (NCHARS N)))
    (PRIN1 N])

(DRAWS
  [LAMBDA (STRUC ID)
    (PROG ((CTAB (fetch CTABLE of STRUC))
           XLATETAB)
          (PRINN (LENGTH CTAB)
                 5)
          (TERPRI)
          (for CTE in CTAB do (PRINENTRY (fetch NODENUM of CTE)
                                         (fetch ATOMTYPE of CTE)
                                         (fetch NBRS of CTE)))
          (PRIN1 " ")
          (PRINRADOFF XLATETAB (OR ID (fetch UGRAPH of STRUC])

(GENLET
  [LAMBDA (AT)
    (OR (for PR in XLATETAB any (AND (EQUAL AT (CDR PR))
                                     (CAR PR)))
        (CAAR (SETQ XLATETAB
                (CONS (CONS (for LET
                               in (QUOTE (X Y Z W # & ← ≠ ! @ ? V T R Q M L J 
                                            G E D A))
                               suchthat (NOT (ASSOC LET XLATETAB)))
                            AT)
                      XLATETAB])

(PRINRAD
  [LAMBDA (L XLATETAB TITLE)
    (PROG (N)
          (SETQ N (NUMNODES L))
          (PRINN N 5)
          (TERPRI)
          (PRINRAD1 NIL (for I to N collect I)
                    L)
          (PRINRADOFF L (OR TITLE (COLLECTUGRAPH L])

(NUMNODES
  [LAMBDA (RAD)
    (IPLUS [for R in (fetch ATTACHEDRADS of RAD)
              sum (ITIMES (CDR R)
                          (NUMNODES (CAR R]
           (COND
             ((NULL (FETCH CENTER OF RAD))
               0)
             ((ATOM (FETCH CENTER OF RAD))
               1)
             ([NOT (type? STRUCTURE (fetch RADSTRUC
                                       of (fetch CENTER of RAD]
               1)
             (T (LENGTH (NODES (FETCH RADSTRUC OF (FETCH CENTER OF RAD])

(PRINRAD1
  [LAMBDA (EFF AA RAD)
    (PROG (CENT ATTACHED J X TTABLE)
          (SETQ CENT (fetch CENTER of RAD))
          (SETQ ATTACHED (CLEXPAND (fetch ATTACHEDRADS of RAD)))
          (RETURN (COND
                    ((NOT CENT)
                      (PRINRAD1 (CADR AA)
                                (CONS (CAR AA)
                                      (PRINRAD1 (CAR AA)
                                                (CDR AA)
                                                (CAR ATTACHED)))
                                (CADR ATTACHED)))
                    ([OR (ATOM CENT)
                         (NOT (type? STRUCTURE (fetch RADSTRUC of CENT]
                      (SETQ X (CDR AA))
                      (for R in ATTACHED do (SETQ J (CONS (CAR X)
                                                          J))
                                            (SETQ X (PRINRAD1 (CAR AA)
                                                              X R)))
                      (PRINENTRY (CAR AA)
                                 CENT
                                 (COND
                                   (EFF (CONS EFF J))
                                   (T J)))
                      X)
                    (T [SETQ X (COND
                           ((NOT EFF)
                             AA)
                           (T (SETQ TTABLE (LIST (LIST (fetch AFFLINK
                                                          of CENT)
                                                       (CAR AA)
                                                       EFF)))
                              (CDR AA]
                       (for N in (NODES (fetch RADSTRUC of CENT))
                          when (NEQ N (fetch AFFLINK of CENT))
                          do (SETQ TTABLE (CONS (LIST N (CAR X))
                                                TTABLE))
                             (SETQ X (CDR X)))
                       [for NLIST in (fetch CUFFLINKS of CENT)
                          do (for C in NLIST bind CT
                                do (NCONC1 (SETQ CT (LMASSOC C TTABLE NIL))
                                           (CAR X))
                                   (SETQ X (PRINRAD1 (CAR CT)
                                                     X
                                                     (CAR ATTACHED)))
                                   (SETQ ATTACHED (CDR ATTACHED]
                       (PRINCTAB (fetch CTABLE of (fetch RADSTRUC of CENT))
                                 TTABLE)
                       X])

(PRINCTAB
  [LAMBDA (CTAB TTABLE)
    (for CT in CTAB bind CPRIME eachtime CPRIME←(LMASSOC CT:NODENUM TTABLE)
       do (PRINENTRY CPRIME:1 CT:ATOMTYPE
                     <! CPRIME::1 ! (for Y in CT:NBRS when Y}='FV
                                       rcollect (CAR (LMASSOC Y TTABLE NIL))) >]
)

(PRINENTRY
  [LAMBDA (N AT CON)
    (PRINN N 3)
    (PRIN1 " ")
    [PRIN1 (COND
             ((EQ 1 (NCHARS AT))
               AT)
             [(NOT AT)
               (for X in CON count (EQ X (QUOTE FV]
             (T (GENLET AT]
    (TAB 6)
    [MAPC CON (FUNCTION (LAMBDA (X)
              (OR (EQ X (QUOTE FV))
                  (PRINN X 3]
    (TERPRI])

(PRINRADOFF
  [LAMBDA (L TITLE)
    (TERPRI)
    (SPACES 1)
    (AND TITLE (PRINT TITLE))
    [COND
      (XLATETAB (for PR in XLATETAB do (SPACES 1)
                                       (PRIN1 (CAR PR))
                                       (PRIN1 " = ")
                                       (PRINT (CDR PR]
    (PRINT (QUOTE END*])
)
  (RPAQ DRAWFORK)
  (ADDTOVAR USERMACROS (DRAW X (E (DRAW (## . X))
                                  T))
            (DRAW NIL (DRAW)))
  (ADDTOVAR EDITCOMSA DRAW)
  (ADDTOVAR EDITCOMSL DRAW)
(DEFLIST(QUOTE(
  [SUBSYS-IN-DRAW ((DRAW . SUBSYS)
                   (AFTER NIL (RETURN (KFORK !VALUE]
))(QUOTE READVICE))

STOP